Como tunar seu modelo de KNN de forma simples

Este projeto tem como objetivo documentar o processo de escolha de modelo de machine learning, demonstrando que até mesmo modelos simples podem performar bons resultados quando aplicados de maneira coerente.

Para isso, utilizaremos um banco de dados com poucas observações e utilizaremos o método Grid Search para seleção de hiper parâmetros e o método Leave One Out para validação dos modelos. E a metodologia a ser abordada será o KNN (K Vizinhos mais próximos), que possui uma teoria simples por trás do algoritmo, e não há possíveis “empecilhos” em razão de pressupostos de distribuição.

Com isto estabelecido, podemos iniciar nossa análise!

Preparando o terreno

Bibliotecas e semente

require(kknn)
require(tidyverse)
require(GGally)
require(plotly)
set.seed(2100)

Funções

Para não “poluir” o corpo do código, iremos definir algumas funções para utilizá-las posteriormente, facilitando a interpretação futura. São elas:

• Criar um data frame vazio com as colunas para identificar cada modelo criado
• Popular um data frame já existente, informando a posição e valores
• Calcular a acurácia
• Criar combinações agrupando variáveis estabelecidas

# Criar data frame
df_vazio <- function(){
  df <- tibble(
    K           = integer(),
    Distancia   = integer(),
    Peso        = character(),
    Var_ID      = integer(),
    Score       = numeric()
  )
  return(df)
} 
# Popular data frame
popular_df <- function(df, contador, k, dist, peso, var, score){
  df[contador, "K"]           <- k
  df[contador, "Distancia"]   <- dist
  df[contador, "Peso"]        <- peso
  df[contador, "Var_ID"]      <- var
  df[contador, "Score"]       <- score
  
  return(df)
}
# Calcular a Acurácia
calcular_acc <- function(teste, fitted, variavel){
  real <- pull(teste[,variavel])
  acc <- ((sum(real == fitted))/length(fitted))
  
  return(acc)
}
# Criar combinações
calcular_combinacoes <- function(df, posicoes){
  df  <- df[,posicoes]
  col <- names(df)
  N <- length(col)
  variaveis <- list()
  index <- 0
  for(i in 1:N){
    index <- index + 1
    variaveis[[index]] <- combn(x = col, i)
  }
  
  variaveis_2 <- list()
  index <- 0
  N <- length(variaveis)
  for(i in 1:N){
    M <- ncol(variaveis[[i]])
    for(j in 1:M){
    index <- index + 1
    variaveis_2[[index]] <- variaveis[[i]][,j]
    }
  }
  
  return(variaveis_2)
}

Dados

Os dados a serem utilizados, são de domínio público e podem ser obtidos na biblioteca carData, sob nome de “National Statistics From The United Nations, Mostly From 2009–2011”.

Possui informações referentes à 213 lugares, como saúde, bem-estar e educação.

O intuito deste projeto não é lidar com dados não balanceados, portanto iremos pegar dados somente das regiões Africa e Asia, que possuem quantidade semelhante de observações.

Como também não temos uma grande quantidade de features, não utilizaremos nenhum método de seleção de features mais sofisticado, iremos olhar apenas para a performance histórica de cada modelo.

head(carData::UN) %>%
  print()

summary(carData::UN$region) %>% 
  print()

       Africa          Asia     Caribbean        Europe    Latin Amer North America NorthAtlantic       Oceania 
           53            50            17            39            20             2             1            17 
         NA's 
           14 

data <- carData::UN %>%
  as_tibble() %>%
  dplyr::filter(region %in% c('Africa', "Asia")) %>%
  dplyr::select(-group) %>%
  na.omit() %>%
  mutate(ID = 1:n())
print(data)

print(ggpairs(data, aes(colour = region)))

Podemos verificar na diagonal principal as densidades de cada variável para cada região, em que África é vermelho e Ásia é azul. Apenas no “olho” diria que lifeExpF é minha favorita para distinguir as regiões.

Separando os dados

Agora iremos dividir nossos dados em duas partes:

• Modelo: dados que serão utilizados para criação e escolha do possível melhor modelo. (Será dividido em treino e teste ainda)
• Fora: dados que não serão utilizados para criação de nenhum modelo. Será utilizado para verificarmos a performance do modelo escolhido em novos dados.

Temos 102 observações no total, utilizaremos 82 para criar o modelo, e 20 para testá-lo.

data_fora <- data %>%
  group_by(region) %>%
  sample_n(size = 10, replace = F)  # Pegando aleatoriamente 10 observações de cada região
print(data_fora)

data_model <- data %>%
  dplyr::filter(!(ID %in% data_fora$ID)) %>%
  sample_frac(size = 1) # Aqui estamos embaralhando os dados
print(data_model)

# Fold
qtd_fold <- nrow(data_model)
folds <- cut(1:nrow(data_model), breaks = qtd_fold, label = F)
data_model <- data_model %>%
  mutate(Fold = folds)
print(data_model)

Escolha do Modelo

Escolha dos hiper parâmetros: Grid Search

Nada mais é do que uma palavra bonita para se testar todas as combinações possíveis para os valores estabelecidos. No nosso caso, iremos variar alguns valores de K, alguns valores para a distância de Minkowski, e as variáveis escolhidas para se treinar o modelo.

Totalizando 620 modelos distintos.

Validação: Leave One Out

Como o próprio nome sugere: vamos deixar um de fora.

Para cada um dos 620 modelos existentes, iremos separar as 82 observações em 82 partes, ou seja, iremos treinar com 81 observações e testar com a outra restante. E assim, iremos calcular a acurácia média dessas 82 divisões. Simples, não?

Essa maneira de validar é controversa, pois é muito sucetível à outliers, porém como estamos trabalhando com um volume de dados bem pequeno, se torna inviável criar poucas divisões com maiores quantidades de dados, como por exemplo o K-Fold Validation com 3, 5 ou 10 partes. Desse modo o LOOCV (Leave One Out Cross Validation) se torna uma das maneiras de driblar a falta de dados.

Modelagem

Variáveis que serão populadas

O pacote kknn suporta diversas variações de kernel (que estamos chamando de peso) porém iremos utilizar apenas a padrão, que é a ‘retangular’. Recomendo fortemente olhar a documentação do pacote: https://www.rdocumentation.org/packages/kknn/versions/1.3.1/topics/kknn

dist <- c(1, 1.5, 2, 3)
peso <- 'rectangular'
kviz <- c(1, 3, 5, 7, 9)
acc <- c()
df <- df_vazio()
contador <- 1
variaveis <- calcular_combinacoes(df = data_model, posicoes = c(2:6))
print(head(variaveis, n = 5))

[[1]]
[1] "fertility"

[[2]]
[1] "ppgdp"

[[3]]
[1] "lifeExpF"

[[4]]
[1] "pctUrban"

[[5]]
[1] "infantMortality"

print(tail(variaveis, n = 5))

[[1]]
[1] "fertility"       "ppgdp"           "lifeExpF"        "infantMortality"

[[2]]
[1] "fertility"       "ppgdp"           "pctUrban"        "infantMortality"

[[3]]
[1] "fertility"       "lifeExpF"        "pctUrban"        "infantMortality"

[[4]]
[1] "ppgdp"           "lifeExpF"        "pctUrban"        "infantMortality"

[[5]]
[1] "fertility"       "ppgdp"           "lifeExpF"        "pctUrban"        "infantMortality"

Criação dos modelos

Esse pequeno bloco de código é a nossa cereja do bolo. Aqui contém toda a essência de nossa análise, populando todos os valores de parâmetros e sua respectiva performance para compararmos posteriormente.

for(var_id in 1:length(variaveis)){
  var <- variaveis[[var_id]]
  for(d in dist){
    for(p in peso){
      for(k in kviz){
        for(fold in 1:qtd_fold){
          train <- data_model %>%
            dplyr::filter(Fold != fold) %>%
            dplyr::select(region, var)
          
          test <- data_model %>%
            dplyr::filter(Fold == fold) %>%
            dplyr::select(region, var)
          
          predict <- kknn(region ~ ., train = train, test = test, k = k, kernel = p, distance = d, scale = T)
          
          acc[fold] <- calcular_acc(teste = test, fitted = predict$fitted.values, variavel = "region")
        }
        df <- popular_df(df = df, contador = contador, k = k, dist = d, peso = p, var = var_id, score = mean(acc))
        contador <- contador + 1
      }
    }
  }
}

Resultado

Checando as performances

df %>%
  arrange(desc(Score)) %>%
  print()

df %>%
  arrange(Score) %>%
  print()

Temos que o melhor modelo teve uma acurácia próxima de 90% e o pior, próximo de 60%. Uma diferença grotesca de performance. E obviamente, agora iremos utilizar os parâmetros do modelo com maior acurácia para testar nos dados que deixamos de fora da seção de modelagem.

Aplicando o modelo

escolhido <- df %>%
  arrange(desc(Score)) %>%
  slice(1)
print(escolhido)

k_escolhido    <- escolhido$K
peso_escolhido <- escolhido$Peso
dist_escolhido <- escolhido$Distancia
var_escolhido  <- variaveis[[escolhido$Var_ID]]
print(var_escolhido)

[1] "fertility" "ppgdp"     "lifeExpF" 

plot_ly(x = data_model$fertility, 
        y = data_model$ppgdp, 
        z = data_model$lifeExpF, 
        color = data_model$region,
        type = 'scatter3d')

No scatter3d mode specifed:
  Setting the mode to markers
  Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode
No scatter3d mode specifed:
  Setting the mode to markers
  Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode

fit <- kknn(region~., 
          train = dplyr::select(data_model,region, var_escolhido), 
          test = data_fora, 
          k = k_escolhido, 
          kernel = peso_escolhido, 
          distance = dist_escolhido,
          scale = TRUE)
data.frame(True = data_fora$region,
           Predict = fit$fitted.values) %>%
  print()

table(fit$fitted.values == data_fora$region) %>%
  print()

FALSE  TRUE 
    1    19 

calcular_acc(teste = data_fora, fitted = fit$fitted.values, variavel = 'region') %>%
  print()

[1] 0.95

A validação com novos dados performou melhor do que o esperado. Porém é algo que sempre pode acontecer, assim como poderia performar pior do que esperamos. Afinal, por mais que tentemos criar o melhor modelo possível, trabalhamos com estatística e probabilidade, e não com bolas de cristal.

E assim concluímos nosso projeto. Vimos que os modelos mais simplistas também podem performar bons resultados, e não há motivo para se afobar quando for iniciar um projeto de Data Science. Começar pela solução mais complexa é meter os pés pelas mãos, pois há casos em que uma solução que apenas um Sênior conseguiria desenvolver perfomaria apenas um pouco melhor do que um (estagiário + google) com uma regressão logística ou KNN conseguiria fazer.